home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / s / s_color1 / schieber / schieber.gfa (.txt) < prev    next >
Encoding:
GFA-BASIC Atari  |  1996-09-18  |  18.9 KB  |  952 lines
  1. '
  2. ON ERROR GOSUB gfa1
  3. ' ON BREAK GOSUB gfa2
  4. ON BREAK CONT
  5. HIDEM
  6. DPOKE 9952,319
  7. DPOKE 9954,199
  8. STICK 1
  9. '
  10. SETCOLOR 0,0
  11. SETCOLOR 15,7,7,7
  12. DIM ss%(5)
  13. DIM hi$(12)
  14. DIM hi%(12)
  15. '
  16. RESTORE sdat1
  17. FOR i%=1 TO 5
  18.   READ q1%
  19.   ss%(i%)=q1%
  20. NEXT i%
  21. ' ---------------------------------------------------------------------
  22. level%=1
  23. life%=4
  24. altlevel%=1
  25. ' ----------------------------------------------------------------------
  26. GOSUB pic1
  27. HIDEM
  28. PRINT AT(9,7);
  29. FORM INPUT 15 AS player$
  30. IF player$=""
  31.   player$="niemando"
  32. ENDIF
  33. play$="               "
  34. RSET play$=player$
  35. play$=UPPER$(play$)
  36. '
  37. CLOSE #1
  38. OPEN "R",#1,"A:\SCHIEBER\EINS.RAD",30
  39. FIELD #1,15 AS n$,15 AS nn$
  40. '
  41. spieler_nr%=0
  42. auweh%=0
  43. '
  44. FOR i%=1 TO 100
  45.   GET #1,i%
  46.   ' --------------------
  47.   IF n$="               " AND auweh%=0   !LEERER EINTRAG
  48.     platz%=i%
  49.     auweh%=1
  50.   ENDIF
  51.   ' --------------------
  52.   IF n$=play$
  53.     player$=n$
  54.     high%=VAL(nn$)
  55.     spieler_nr%=i%
  56.   ENDIF
  57.   EXIT IF spieler_nr%<>0
  58. NEXT i%
  59. CLOSE #1
  60. '
  61. ' IN PLAYER$=SPIELERNAME
  62. ' IN HIGH%=DER HIGHSCORE
  63. ' SPIELER_NR%=DATENSATZNUMMER
  64. IF spieler_nr%<>0
  65.   platz%=spieler_nr%
  66.   PRINT AT(18,22);high%
  67.   '
  68.   PRINT AT(9,14);
  69.   FORM INPUT 5 AS pass$
  70.   pass$=UPPER$(pass$)
  71.   IF pass$=""
  72.     GOTO fangneuan
  73.   ENDIF
  74.   ' -------------------------------------------------------------------
  75.   ' PASSTEST ZUR LEVELAUSWAHL
  76.   CLOSE #1
  77.   das%=0
  78.   OPEN "R",#1,"A:\SCHIEBER\ZWEI.RAD",5
  79.   FIELD #1,5 AS passy$
  80.   FOR i%=1 TO 100
  81.     GET #1,i%
  82.     IF passy$=pass$
  83.       level%=i%
  84.       altlevel%=level%
  85.       das%=1
  86.     ENDIF
  87.     EXIT IF das%=1
  88.   NEXT i%
  89.   CLOSE #1
  90.   ' ---------------------------------------------------------------------
  91. fangneuan:
  92.   '
  93. ELSE
  94.   player$=play$
  95. ENDIF
  96. '
  97. ' ENDGÜLTIG DATENSATZNUMMER=PLATZ%   ALLE SPEICHERVORGÄNGE DARÜBER
  98. '
  99. ' ---------------------------
  100. GOSUB pic2
  101. PRINT AT(4,16);player$
  102. PRINT AT(4,21);"HIGHSCORE ";high%
  103. total%=188
  104. IF level%<31
  105.   napf%=level%
  106. ELSE
  107.   napf%=30
  108. ENDIF
  109. FOR i%=1 TO napf%
  110.   PBOX 224,total%-3,228,total%-1
  111.   SUB total%,4
  112. NEXT i%
  113. ' ------------------------------------------
  114. CLOSE #1
  115. OPEN "I",#1,"A:\SCHIEBER\HIGH"
  116. FOR i%=1 TO 12
  117.   INPUT #1,hi$(i%)
  118. NEXT i%
  119. FOR i%=1 TO 12
  120.   INPUT #1,q1%
  121.   hi%(i%)=q1%
  122. NEXT i%
  123. CLOSE #1
  124. '
  125. SGET screen$
  126. ' -------------------------------------------
  127. '
  128. SPUT screen$
  129. ' -------------------------------------------
  130. GOSUB bilo
  131. neueslevel:
  132. anzeige%=1
  133. STICK 1
  134. GOSUB laden
  135. bon%=100*(level%*2)
  136. bon$="      "
  137. RSET bon$=STR$(bon%)
  138. PRINT AT(33,23);CHR$(27)+"c";+5;bon$;CHR$(27)+"c";0
  139. '
  140. ' #################################################
  141. start:
  142. ' -------------------------
  143. ax%=15       !bildformat
  144. ay%=13
  145. ' -----
  146. m1%=7        !feld zum laufen
  147. m2%=3        !kiste
  148. m3%=4        !spielfigur
  149. m5%=5        !WOHIN ??
  150. ' -------------------------
  151. x%=1
  152. y%=1
  153. sx%=1
  154. sy%=1
  155. ' -----
  156. PUT 15,13,fahr$(2)
  157. EVERY STOP
  158. SETTIME "00:00:00","26.06.1988"
  159. SLPOKE &H4BA,0
  160. ' PRINT AT(1,1);TIMER
  161. zei$=""
  162. EVERY 400 GOSUB zeit
  163. REPEAT
  164. UNTIL STRIG(1)=FALSE
  165. '
  166. haupt:
  167. '
  168. ' PRINT AT(1,23);sx%;" ";sy%;" "
  169. ' -------------------------
  170. PAUSE 5
  171. ' ------
  172. GOSUB joy
  173. ' ------
  174. IF TIMER>36000+(6000*level%)
  175.   EVERY STOP
  176.   FOR i%=1 TO 6
  177.     PRINT AT(33,4);CHR$(27)+"c";+2;zei$;" ";CHR$(27)+"c";0
  178.     PAUSE 20
  179.     PRINT AT(33,4);CHR$(27)+"c";+5;zei$;" ";CHR$(27)+"c";0
  180.     PAUSE 20
  181.   NEXT i%
  182.   feuer%=TRUE
  183. ENDIF
  184. '
  185. IF feuer%=TRUE
  186.   GOSUB test
  187.   ' -----
  188.   IF ohno%=0          !GESCHAFFT
  189.     EVERY STOP
  190.     d%=TIMER
  191.     d%=36000-d%
  192.     ADD score%,d% DIV 10
  193.     ADD score%,bon%
  194.     GOSUB sou1
  195.     GOSUB siege
  196.     GOTO neueslevel
  197.   ENDIF
  198.   ' -----
  199.   IF life%>0
  200.     GOSUB sou1
  201.     RESTORE zu
  202.     FOR i%=1 TO life%
  203.       READ lx%,ly%
  204.     NEXT i%
  205.     DEFFILL 6
  206.     PBOX lx%,ly%,lx%+15,ly%+15
  207.     DEFFILL 7
  208.     PBOX lx%+2,ly%+2,lx%+13,ly%+13
  209.     DEC life%
  210.     GOSUB neues
  211.     GOTO start
  212.   ELSE
  213.     GOTO vorbei
  214.   ENDIF
  215.   ' -----
  216.   IF x%<0 OR x%>20 OR y%<0 OR y%>15
  217.     GOTO haupt
  218.   ENDIF
  219.   ' -----
  220. ENDIF
  221. ' -------------------------
  222. IF x%>sx%+1
  223.   GOTO haupt
  224. ENDIF
  225. ' -----
  226. IF x%<sx%-1
  227.   GOTO haupt
  228. ENDIF
  229. ' -----
  230. IF y%>sy%+1
  231.   GOTO haupt
  232. ENDIF
  233. ' -----
  234. IF y%<sy%-1
  235.   GOTO haupt
  236. ENDIF
  237. ' -----
  238. was%=f%(x%+1,y%+1)
  239. ' -----
  240. SELECT was%
  241.   '  PRINT AT(1,24);was%;"<<"
  242.   ' -----
  243. CASE 2,5,6,7
  244.   frei%=0
  245. CASE 4
  246.   IF sy%=y%+1 OR sy%=y%-1
  247.     frei%=0
  248.   ELSE
  249.     frei%=1
  250.   ENDIF
  251. DEFAULT
  252.   frei%=1
  253. ENDSELECT
  254. IF was%=2
  255.   SUB bon%,5
  256.   IF bon%<0
  257.     bon%=0
  258.   ENDIF
  259.   bon$="      "
  260.   RSET bon$=STR$(bon%)
  261.   PRINT AT(33,23);CHR$(27)+"c";+5;bon$;CHR$(27)+"c";0
  262. ENDIF
  263. ' --------
  264. ' PRINT AT(33,7);frei%;" "
  265. ' -------------------------
  266. IF frei%=0          !FELD FREI
  267.   PUT (sx%)*ax%,(sy%)*ay%,bil$(ff%(sx%+1,sy%+1))
  268.   ' -----
  269.   PUT x%*ax%,y%*ay%,fahr$(fa%)
  270.   sx%=x%
  271.   sy%=y%
  272.   '  FOR i%=1 TO 15 STEP 2
  273.   '  gog%=RANDOM(5)+1
  274.   '  d%=ss%(gog%)
  275.   SOUND 1,12,8,3          !3
  276.   PAUSE 1
  277.   SOUND 0,0,0,0,0
  278.   GOTO weiter4          !gelaufen
  279. ENDIF
  280. IF frei%=1 AND was%<>3
  281.   GOTO weiter4   !#####################
  282. ENDIF
  283. ' -------------------------
  284. zx%=x%+1               !FELDPOSITION
  285. zy%=y%+1               !FELDPOSITION
  286. ' -----
  287. ' -----
  288. IF sx%=x%                  !hoch runter
  289.   ' -----
  290.   IF y%=sy%-1              !HOCH
  291.     GOSUB hoch
  292.     GOTO weiter3
  293.   ENDIF
  294.   ' -----
  295.   IF y%=sy%+1              !RUNTER
  296.     GOSUB runter
  297.     GOTO weiter3
  298.   ENDIF
  299.   ' -----
  300. ENDIF
  301. ' -------------------------
  302. ' -------------------------
  303. IF sy%=y%                  !LINKS RECHTS
  304.   ' -----
  305.   IF x%=sx%-1              !LINKS
  306.     GOSUB links
  307.     GOTO weiter3
  308.   ENDIF
  309.   ' -------------------------
  310.   IF x%=sx%+1               !RECHTS#######################################
  311.     GOSUB rechts
  312.   ENDIF
  313.   GOTO weiter3
  314. ENDIF
  315. ' -----
  316. weiter3:
  317. SOUND 1,13,6,2
  318. PAUSE 2
  319. SOUND 0,0,0,0,0
  320. weiter4:
  321. ' -----
  322. GOTO haupt
  323. ' --------------------------
  324. vorbei:
  325. EVERY STOP
  326. '
  327. GOSUB pic3
  328. '
  329. '
  330. STICK 0
  331. GOSUB sort
  332. '
  333. PRINT AT(4,22);player$;" SCORE ";score%
  334. IF hoch%=1
  335.   GOSUB high
  336.   hoch%=0
  337. ENDIF
  338. PAUSE 20
  339. REPEAT
  340. UNTIL STRIG(1)=TRUE
  341. level%=altlevel%
  342. score%=0
  343. life%=4
  344. SPUT screen$
  345. GOTO neueslevel
  346. '
  347. STOP
  348. GOSUB gfa2
  349. ' ---------------------------
  350. ' -------------------------
  351. > PROCEDURE test
  352.   ' -----
  353.   ohno%=0
  354.   zap%=0
  355.   ' -----
  356.   FOR i%=1 TO fx%
  357.     FOR ii%=1 TO fy%
  358.       IF f%(i%,ii%)=m2% AND ff%(i%,ii%)<>m5%    !KISTE WOHINFELD%
  359.         ohno%=1
  360.       ENDIF
  361.       IF f%(i%,ii%)=m2% AND ff%(i%,ii%)=m5% AND ohno%=0    !KISTE WOHINFELD%
  362.         INC zap%
  363.         ADD score%,(50*level%)*zap%
  364.       ENDIF
  365.     NEXT ii%
  366.   NEXT i%
  367.   ' -----
  368. RETURN
  369. ' -------------------------
  370. > PROCEDURE maus(sc1%,sc2%,sc3%,sc4%,sc5%,sc6%)
  371.   ' teiler x, teiler y,bereich <x >x bereich <y >y
  372.   '
  373.   PAUSE 20
  374.   SHOWM
  375.   '
  376. mausin:
  377.   REPEAT
  378.     MOUSE x%,y%,k%
  379.     x%=x% DIV sc1%
  380.     y%=y% DIV sc2%
  381.     '
  382.     '    PRINT AT(33,1);f%(x%+1,y%+1);" "
  383.     '    PRINT AT(33,2);ff%(x%+1,y%+1);" "
  384.     '
  385.   UNTIL k%
  386.   IF x%<sc3% OR x%>sc4%
  387.     GOTO mausin
  388.   ENDIF
  389.   IF y%<sc5% OR y%>sc6%
  390.     GOTO mausin
  391.   ENDIF
  392.   '
  393. mausex:
  394.   '
  395.   '  PRINT x%;" ";y%
  396. RETURN
  397. ' -------------------------
  398. > PROCEDURE joy
  399. joyin:
  400.   x%=sx%
  401.   y%=sy%
  402.   '
  403.   feuer%=STRIG(1)
  404.   IF feuer%=TRUE
  405.     GOTO joyex
  406.   ENDIF
  407.   '
  408.   richtung%=STICK(1)
  409.   SELECT richtung%
  410.   CASE 4
  411.     DEC x%
  412.     fa%=1
  413.   CASE 8
  414.     INC x%
  415.     fa%=2
  416.   CASE 2
  417.     INC y%
  418.     fa%=5
  419.   CASE 1
  420.     DEC y%
  421.     fa%=4
  422.   ENDSELECT
  423.   IF x%=sx% AND y%=sy%
  424.     GOTO joyin
  425.   ENDIF
  426. joyex:
  427. RETURN
  428. ' -------------------------
  429. > PROCEDURE hoch
  430.   ' -----
  431.   w2%=f%(zx%,zy%)            !1 FELD DANACH
  432.   w3%=f%(zx%,zy%-1)          !2 FELD DANACH
  433.   IF w2%<2 OR w3%=m2%       !WAND
  434.     GOTO hochex             !KEIN LAUFEN
  435.   ENDIF
  436.   ' -----
  437.   IF w2%=m2% AND w3%>1       !KISTE UND EXTRAFELD ODER LAUFEN
  438.     w4%=ff%(zx%,zy%)       !KISTENFELD
  439.     IF w4%=m2%               !AUCH KISTE   WEG DAMIT
  440.       ff%(zx%,zy%)=m1%     !NUN LAUFFELD
  441.     ENDIF
  442.   ELSE
  443.     GOTO hochex
  444.   ENDIF
  445.   PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
  446.   PUT x%*ax%,y%*ay%,fahr$(fa%)            !SPIELFIGUR
  447.   PUT x%*ax%,(y%-1)*ay%,bil$(m2%)          !KISTE
  448.   f%(zx%,zy%-1)=m2%                      !DA STEHT SIE NUN
  449.   f%(zx%,zy%)=ff%(zx%,zy%)
  450.   sx%=x%
  451.   sy%=y%
  452. hochex:
  453. RETURN
  454. ' -------------------------
  455. > PROCEDURE runter
  456.   ' -----
  457.   w2%=f%(zx%,zy%)          !1 FELD DANACH
  458.   w3%=f%(zx%,zy%+1)          !2 FELD DANACH
  459.   IF w2%<2 OR w3%=m2%                  !WAND
  460.     GOTO rraus            !KEIN LAUFEN
  461.   ENDIF
  462.   ' -----
  463.   IF w2%=m2% AND w3%>1       !KISTE UND EXTRAFELD ODER LAUFEN
  464.     w4%=ff%(zx%,zy%)           !KISTENFELD
  465.     IF w4%=m2%               !AUCH KISTE   WEG DAMIT
  466.       ff%(zx%,zy%)=m1%       !NUN LAUFFELD
  467.     ENDIF
  468.   ELSE
  469.     GOTO rraus
  470.   ENDIF
  471.   PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
  472.   PUT x%*ax%,y%*ay%,fahr$(fa%)         !SPIELFIGUR
  473.   PUT x%*ax%,(y%+1)*ay%,bil$(m2%)       !KISTE
  474.   f%(zx%,zy%+1)=m2%                      !DA STEHT SIE NUN
  475.   f%(zx%,zy%)=ff%(zx%,zy%)
  476.   sx%=x%
  477.   sy%=y%
  478. rraus:
  479. RETURN
  480. ' -------------------------
  481. > PROCEDURE links
  482.   ' -----
  483.   w2%=f%(zx%,zy%)          !1 FELD DANACH
  484.   w3%=f%(zx%-1,zy%)          !2 FELD DANACH
  485.   IF w2%<2 OR w3%=m2%                 !WAND
  486.     GOTO linksex             !KEIN LAUFEN
  487.   ENDIF
  488.   ' -----
  489.   IF w2%=m2% AND w3%>1       !KISTE UND EXTRAFELD ODER LAUFEN
  490.     w4%=ff%(zx%,zy%)       !KISTENFELD
  491.     IF w4%=m2%               !AUCH KISTE   WEG DAMIT
  492.       ff%(zx%,zy%)=m1%     !NUN LAUFFELD
  493.     ENDIF
  494.   ELSE
  495.     GOTO linksex
  496.   ENDIF
  497.   PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
  498.   PUT x%*ax%,y%*ay%,fahr$(fa%)         !SPIELFIGUR
  499.   PUT (x%-1)*ax%,y%*ay%,bil$(m2%)            !KISTE
  500.   f%(zx%-1,zy%)=m2%                      !DA STEHT SIE NUN
  501.   f%(zx%,zy%)=ff%(zx%,zy%)
  502.   sx%=x%
  503.   sy%=y%
  504. linksex:
  505. RETURN
  506. ' -------------------------
  507. > PROCEDURE rechts
  508.   ' -----
  509.   w2%=f%(zx%,zy%)          !1 FELD DANACH
  510.   w3%=f%(zx%+1,zy%)          !2 FELD DANACH
  511.   IF w2%<2 OR w3%=m2%                 !WAND
  512.     GOTO rechtsex            !KEIN LAUFEN
  513.   ENDIF
  514.   ' -----
  515.   IF w2%=m2% AND w3%>1       !KISTE UND EXTRAFELD ODER LAUFEN
  516.     w4%=ff%(zx%,zy%)       !KISTENFELD
  517.     IF w4%=m2%               !AUCH KISTE   WEG DAMIT
  518.       ff%(zx%,zy%)=m1%     !NUN LAUFFELD
  519.     ENDIF
  520.   ELSE
  521.     GOTO rechtsex
  522.   ENDIF
  523.   PUT sx%*ax%,sy%*ay%,bil$(ff%(sx%+1,sy%+1)) !FELD ALTE POSITION
  524.   PUT x%*ax%,y%*ay%,fahr$(fa%)         !SPIELFIGUR
  525.   PUT (x%+1)*ax%,y%*ay%,bil$(m2%)            !KISTE
  526.   f%(zx%+1,zy%)=m2%                      !DA STEHT SIE NUN
  527.   f%(zx%,zy%)=ff%(zx%,zy%)
  528.   sx%=x%
  529.   sy%=y%
  530. rechtsex:
  531. RETURN
  532. '
  533. PROCEDURE zeit
  534.   zei$=MID$(TIME$,4,5)
  535.   PRINT AT(33,4);CHR$(27)+"c";+5;zei$;" ";CHR$(27)+"c";0
  536. RETURN
  537. '
  538. > PROCEDURE siege
  539.   STICK 0
  540.   SPUT screen$
  541.   INC level%
  542.   IF score%>high%
  543.     high%=score%
  544.     hoch%=1
  545.   ENDIF
  546.   '
  547.   DEFFILL 9
  548.   '
  549.   total%=188
  550.   FOR i%=1 TO level%
  551.     PBOX 224,total%-3,228,total%-1
  552.     SUB total%,4
  553.   NEXT i%
  554.   '
  555.   '
  556.   PRINT AT(4,16);player$
  557.   PRINT AT(4,18);"nächste Etage ist ";level%
  558.   PRINT AT(4,20);"SCORE     ";score%
  559.   PRINT AT(4,21);"HIGHSCORE ";high%
  560.   PAUSE 20
  561.   REPEAT
  562.   UNTIL MOUSEK
  563. RETURN
  564. > PROCEDURE high
  565.   CLOSE #1
  566.   n$=player$
  567.   play$=STR$(high%)
  568.   nn$="               "
  569.   RSET nn$=play$
  570.   ' -------------------------------------
  571.   OPEN "R",#1,"A:\SCHIEBER\EINS.RAD",30
  572.   FIELD #1,15 AS n$,15 AS nn$
  573.   PUT #1,platz%
  574.   CLOSE #1
  575.   '
  576. RETURN
  577. '
  578. ' -------------------------
  579. PROCEDURE laden
  580.   fox%=EXIST("A:\SCHIEBER\LEVEL"+STR$(level%)+".FLD")
  581.   IF fox%=0
  582.     level%=1
  583.   ENDIF
  584.   ' -----
  585.   CLOSE #1
  586.   ' -----
  587.   OPEN "I",#1,"A:\SCHIEBER\LEVEL"+STR$(level%)+".FLD"
  588.   ' -----
  589.   INPUT #1,fx%        !GROESSE
  590.   INPUT #1,fy%
  591.   INPUT #1,xmax%
  592.   INPUT #1,ymax%
  593.   ' -----
  594.   ERASE f%()
  595.   ERASE ff%()
  596.   ERASE fff%()
  597.   ' -----
  598.   DIM f%(fx%,fy%)
  599.   DIM ff%(fx%,fy%)
  600.   DIM fff%(fx%,fy%)
  601.   ' -----
  602.   FOR i%=1 TO fx%
  603.     FOR ii%=1 TO fy%
  604.       INPUT #1,q1%
  605.       DEC q1%
  606.       f%(i%,ii%)=q1%
  607.       ff%(i%,ii%)=q1%
  608.       fff%(i%,ii%)=q1%
  609.     NEXT ii%
  610.   NEXT i%
  611.   CLOSE #1
  612.   ' -----
  613.   SUB fx%,2
  614.   SUB fy%,2
  615.   xx%=xmax% DIV fx%
  616.   yy%=ymax% DIV fy%
  617.   '
  618.   IF anzeige%=0
  619.     GOTO ladenex
  620.   ENDIF
  621.   OPEN "R",#1,"A:\SCHIEBER\ZWEI.RAD",5
  622.   FIELD #1,5 AS passy$
  623.   GET #1,level%
  624.   CLOSE #1
  625.   PRINT AT(4,23);"PASSWORT IST ";passy$
  626.   PAUSE 20
  627.   REPEAT
  628.   UNTIL STRIG(1)=TRUE
  629.   '
  630.   ' -----
  631.   ' -------------------------
  632.   COLOR 0
  633.   y1%=100
  634.   y2%=100
  635.   FOR i%=1 TO 100
  636.     LINE 0,y1%,240,y1%
  637.     LINE 0,y2%,240,y2%
  638.     INC y2%
  639.     DEC y1%
  640.   NEXT i%
  641.   ' -----
  642.   ' -------------------------
  643.   x%=0
  644.   y%=0
  645.   ' -----
  646.   FOR i%=1 TO fy%
  647.     FOR ii%=1 TO fx%
  648.       ' -----
  649.       q1%=f%(ii%,i%)
  650.       IF q1%=3
  651.         q1%=7
  652.       ENDIF
  653.       '
  654.       '
  655.       PUT x%,y%,bil$(q1%)
  656.       ADD x%,xx%
  657.     NEXT ii%
  658.     ADD y%,yy%
  659.     x%=0
  660.   NEXT i%
  661.   ' -----
  662.   x%=0
  663.   y%=0
  664.   ' -----
  665.   FOR i%=1 TO fy%
  666.     FOR ii%=1 TO fx%
  667.       ' -----
  668.       q1%=f%(ii%,i%)
  669.       IF q1%=3
  670.         '
  671.         PUT x%,y%,bil$(q1%)
  672.         GOSUB sou2
  673.         '
  674.       ENDIF
  675.       '
  676.       ADD x%,xx%
  677.     NEXT ii%
  678.     ADD y%,yy%
  679.     x%=0
  680.   NEXT i%
  681.   ' -----
  682. ladenex:
  683.   altlevel%=level%
  684. RETURN
  685. ' -------------------------
  686. > PROCEDURE neues
  687.   ' -----
  688.   FOR i%=1 TO fx%
  689.     FOR ii%=1 TO fy%
  690.       q1%=fff%(i%,ii%)
  691.       f%(i%,ii%)=q1%
  692.       ff%(i%,ii%)=q1%
  693.     NEXT ii%
  694.   NEXT i%
  695.   ' -----
  696.   '
  697.   COLOR 0
  698.   y1%=100
  699.   y2%=100
  700.   FOR i%=1 TO 100
  701.     LINE 0,y1%,240,y1%
  702.     LINE 0,y2%,240,y2%
  703.     INC y2%
  704.     DEC y1%
  705.   NEXT i%
  706.   ' -----
  707.   ' -------------------------
  708.   x%=0
  709.   y%=0
  710.   ' -----
  711.   FOR i%=1 TO fy%
  712.     FOR ii%=1 TO fx%
  713.       ' -----
  714.       q1%=f%(ii%,i%)
  715.       IF q1%=3
  716.         q1%=7
  717.       ENDIF
  718.       '
  719.       '
  720.       PUT x%,y%,bil$(q1%)
  721.       ADD x%,xx%
  722.     NEXT ii%
  723.     ADD y%,yy%
  724.     x%=0
  725.   NEXT i%
  726.   ' -----
  727.   x%=0
  728.   y%=0
  729.   ' -----
  730.   FOR i%=1 TO fy%
  731.     FOR ii%=1 TO fx%
  732.       ' -----
  733.       q1%=f%(ii%,i%)
  734.       IF q1%=3
  735.         '
  736.         PUT x%,y%,bil$(q1%)
  737.         GOSUB sou2
  738.         '
  739.       ENDIF
  740.       '
  741.       ADD x%,xx%
  742.     NEXT ii%
  743.     ADD y%,yy%
  744.     x%=0
  745.   NEXT i%
  746. RETURN
  747. ' ----------------------
  748. > PROCEDURE bilo
  749.   DIM bil$(8)
  750.   DIM fahr$(5)
  751.   '
  752.   FOR i%=1 TO 8
  753.     CLOSE #1
  754.     OPEN "i",#1,"A:\SCHIEBER\ART\test"+STR$(i%)+".qim"
  755.     bil$(i%)=INPUT$((LOF(#1)),#1)
  756.     CLOSE #1
  757.   NEXT i%
  758.   FOR i%=1 TO 5
  759.     CLOSE #1
  760.     OPEN "i",#1,"a:\SCHIEBER\ART\fahr"+STR$(i%)+".qim"
  761.     fahr$(i%)=INPUT$((LOF(#1)),#1)
  762.     CLOSE #1
  763.   NEXT i%
  764. RETURN
  765. '
  766. > PROCEDURE pic1          !eventuell ein degasbild laden ???
  767.   '
  768.   CLOSE #1
  769.   OPEN "i",#1,"A:\SCHIEBER\ART\PASS.PI1"
  770.   farb$=SPACE$(34)                  !originalfarben des bildes laden
  771.   BGET #1,VARPTR(farb$),34          !und in string farb$ ablegen
  772.   z%=0
  773.   FOR i%=3 TO LEN(farb$) STEP 2     !jeweils 2 werte ergeben die farbe
  774.     farb1$=MID$(farb$,i%)             !wert 1
  775.     farb2$=MID$(farb$,i%+1)           !wert 2
  776.     a%=ASC(farb1$)                    !ascii code
  777.     b%=ASC(farb2$)                    !asci code
  778.     c%=a%*256+b%                      !wandeln in farbcode
  779.     SETCOLOR z%,c%                    !in die farbregister damit
  780.     INC z%                            !hilfszahler
  781.   NEXT i%
  782.   BGET #1,XBIOS(3),32000
  783.   CLOSE #1
  784. RETURN
  785. > PROCEDURE pic2          !eventuell ein degasbild laden ???
  786.   '
  787.   CLOSE #1
  788.   OPEN "i",#1,"A:\SCHIEBER\ART\SCHIEBER.PI1"
  789.   farb$=SPACE$(34)                  !originalfarben des bildes laden
  790.   BGET #1,VARPTR(farb$),34          !und in string farb$ ablegen
  791.   z%=0
  792.   FOR i%=3 TO LEN(farb$) STEP 2     !jeweils 2 werte ergeben die farbe
  793.     farb1$=MID$(farb$,i%)             !wert 1
  794.     farb2$=MID$(farb$,i%+1)           !wert 2
  795.     a%=ASC(farb1$)                    !ascii code
  796.     b%=ASC(farb2$)                    !asci code
  797.     c%=a%*256+b%                      !wandeln in farbcode
  798.     SETCOLOR z%,c%                    !in die farbregister damit
  799.     INC z%                            !hilfszahler
  800.   NEXT i%
  801.   BGET #1,XBIOS(3),32000
  802.   CLOSE #1
  803. RETURN
  804. > PROCEDURE pic3          !eventuell ein degasbild laden ???
  805.   '
  806.   CLOSE #1
  807.   OPEN "i",#1,"A:\SCHIEBER\ART\OVER.PI1"
  808.   farb$=SPACE$(34)                  !originalfarben des bildes laden
  809.   BGET #1,VARPTR(farb$),34          !und in string farb$ ablegen
  810.   z%=0
  811.   FOR i%=3 TO LEN(farb$) STEP 2     !jeweils 2 werte ergeben die farbe
  812.     farb1$=MID$(farb$,i%)             !wert 1
  813.     farb2$=MID$(farb$,i%+1)           !wert 2
  814.     a%=ASC(farb1$)                    !ascii code
  815.     b%=ASC(farb2$)                    !asci code
  816.     c%=a%*256+b%                      !wandeln in farbcode
  817.     SETCOLOR z%,c%                    !in die farbregister damit
  818.     INC z%                            !hilfszahler
  819.   NEXT i%
  820.   BGET #1,XBIOS(3),32000
  821.   CLOSE #1
  822. RETURN
  823. ' ----------------------
  824. > PROCEDURE gfa1
  825.   SHOWM
  826.   STICK 0
  827.   SETCOLOR 0,7,7,7
  828.   SETCOLOR 15,0
  829.   CLS
  830.   PRINT AT(1,1);"EIN FEHLER IST AUFGETRETEN"
  831.   PRINT AT(1,2);ERR$(ERR)
  832.   '
  833.   VOID INP(2)
  834.   EDIT
  835. RETURN
  836. ' ----------------------
  837. > PROCEDURE gfa2
  838.   STICK 0
  839.   SHOWM
  840.   SETCOLOR 0,7,7,7
  841.   SETCOLOR 15,0
  842.   CLS
  843.   PRINT AT(1,1);"STOP DURCH BREAK"
  844.   PRINT "FREE BYTES ";FRE(9)
  845.   '
  846.   VOID INP(2)
  847.   EDIT
  848. RETURN
  849. ' ----------------------
  850. zu:
  851. DATA 259,44,283,44,259,61,283,61
  852. '
  853. > PROCEDURE sou1
  854.   SOUND 0,0,0,0,0
  855.   WAVE 0,0
  856.   '
  857.   FOR ii%=1 TO 3
  858.     FOR i%=1 TO 8
  859.       SOUND 1,15,i%,3,1
  860.       SOUND 2,12,8,4,1
  861.       WAVE 3                           !+30*256,2,13,2500*i%,3
  862.       PAUSE 1
  863.       SOUND 0,0,0,0,0
  864.     NEXT i%
  865.   NEXT ii%
  866.   GOSUB sou2
  867. RETURN
  868. > PROCEDURE sou2
  869.   FOR t%=15 DOWNTO 0
  870.     SOUND 1,t%,5,1
  871.     SOUND 2,t%,12,2
  872.     SOUND 3,t%,5,4
  873.     WAVE 7
  874.     FOR d%=0 TO 1000
  875.     NEXT d%
  876.     SOUND 3,t%,5,5
  877.     FOR d%=0 TO 1000
  878.     NEXT d%
  879.   NEXT t%
  880. RETURN
  881. > PROCEDURE sou3
  882.   WAVE 0,0
  883.   FOR iii%=0 TO 1
  884.     RESTORE sdat
  885.     FOR iiii%=1 TO 10
  886.       READ ton%
  887.       WAVE 7
  888.       SOUND 1,15,ton%,6+iii%,2
  889.       SOUND 2,13,ton%,4,1
  890.       SOUND 3,14,ton%+1,2,1
  891.       PAUSE 1.5
  892.     NEXT iiii%
  893.   NEXT iii%
  894.   GOSUB sou2
  895. RETURN
  896. sdat:
  897. DATA 4,5,8,8,3,6,8,6,9,8
  898. sdat1:
  899. DATA 1,5,6,8,10,12
  900. ' ----------------------
  901. > PROCEDURE sort
  902.   '
  903.   nana%=0
  904.   IF high%>hi%(7)
  905.     hi$(7)=player$
  906.     hi%(7)=high%
  907.   ENDIF
  908.   ' ------
  909. na:
  910.   nu%=0
  911.   FOR i%=1 TO 6
  912.     '
  913.     IF hi%(i%)<hi%(i%+1)
  914.       '      PRINT i%;" ";
  915.       q1%=hi%(i%)
  916.       q2%=hi%(i%+1)
  917.       a$=hi$(i%)
  918.       b$=hi$(i%+1)
  919.       hi%(i%)=q2%
  920.       hi%(i%+1)=q1%
  921.       hi$(i%)=b$
  922.       hi$(i%+1)=a$
  923.       nu%=1
  924.       nana%=1
  925.     ENDIF
  926.     '    EXIT IF nu%=1
  927.     '
  928.   NEXT i%
  929.   IF nu%=1
  930.     GOTO na
  931.   ENDIF
  932.   ' ----------------------
  933.   IF nana%=1
  934.     hi%(7)=hi%(6)
  935.     CLOSE #1
  936.     OPEN "O",#1,"A:\SCHIEBER\HIGH"
  937.     FOR i%=1 TO 12
  938.       PRINT #1,hi$(i%)
  939.     NEXT i%
  940.     FOR i%=1 TO 12
  941.       q1%=hi%(i%)
  942.       WRITE #1,q1%
  943.     NEXT i%
  944.     CLOSE #1
  945.   ENDIF
  946.   ' ---------------
  947.   FOR i%=1 TO 6
  948.     PRINT AT(4,14+i%);hi$(i%)
  949.     PRINT AT(24,14+i%);hi%(i%)
  950.   NEXT i%
  951. RETURN
  952.